home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / 3dtabs / tabs.bas < prev    next >
BASIC Source File  |  1995-05-09  |  16KB  |  531 lines

  1. Option Explicit
  2.  
  3. ' used only by demo
  4. Global tabsup%
  5.  
  6. 'constants
  7. Global Const SRCCOPY = &HCC0020
  8. 'flags for painting
  9. Dim loading%, resizing%
  10. 'general purpose
  11. Dim i%, r%
  12.  
  13. Type POINTAPI
  14.     x As Integer
  15.     y As Integer
  16. End Type
  17.  
  18. Type RECT
  19.     left As Integer
  20.     top As Integer
  21.     right As Integer
  22.     bottom As Integer
  23. End Type
  24.  
  25. Type boxsize
  26.     Width As Integer
  27.     Height As Integer
  28. End Type
  29.  
  30. Type twipdata
  31.     'scaling constants for each instance
  32.     x As Integer            'twips/per/pixelx - depends on parent's scale mode
  33.     y As Integer            'twips/per/pixely
  34.     bx As Integer           'width of nonclient in twips
  35.     by As Integer           'height of nonclient
  36. End Type
  37.  
  38. '===========structure to hold the size data===========
  39.  
  40. Type TabData
  41.     'control 'properties' - set by caller
  42.     num As Integer          'num of Page()'s
  43.     active As Integer       'active Page()
  44.     orient As Integer       'up = 0, down = 1
  45.     cols As Integer         'horz# of tabs
  46.     left As Integer         'control left in twips
  47.     top As Integer          'control top in twips
  48.     offset As Integer       'tab angle
  49.     'optional 'properties' - set by caller for sizable windows
  50.     minwidth As Integer     'based on size of captions
  51.     minheight As Integer    'user-defined
  52.     Width As Integer        'width of whole control
  53.     Height As Integer       'height of whole control
  54.     'optional properties for 'nonaligned' controls
  55.     insetx  As Integer
  56.     insety As Integer
  57.     'calculated by DefineControl()
  58.     rows As Integer         '# of tabs horiz
  59.     box As boxsize          'tabbox in pixels
  60.     tab As boxsize          'invbox in pixels
  61.     'twips or pixels,depending on scalemode of parent:
  62.     twp As twipdata
  63. End Type
  64.  
  65. Declare Function BitBlt% Lib "GDI" (ByVal hDestDC%, ByVal x%, ByVal y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal dwRop&)
  66. Declare Sub GetClientRect Lib "User" (ByVal hWnd%, lpRect As RECT)
  67. Declare Function GetParent% Lib "User" (ByVal hWnd%)
  68. Declare Sub GetWindowRect Lib "User" (ByVal hWnd%, lpRect As RECT)
  69.  
  70. Sub DefineControl (F As Form, tbox As Control, ibox As Control, page() As Control, tb As TabData)
  71. Dim pageleft%, pagetop%, pageheight%, pagewidth%
  72. Dim tabtop%, aligned%, w%, h%
  73. Dim theight%, pheight%
  74. '
  75. loading = -1
  76. 'Debug.Print "=========new run================"
  77. zGetScaleData F, tbox, tb
  78.  
  79. 'note:if any of these values have been set by the caller, then
  80. 'the control will be sized to fit them all!
  81. 'otherwise the tab and the Form will be fitted to Page(0)
  82. If tb.left = 0 And tb.top = 0 And tb.Width = 0 And tb.Height = 0 Then aligned = -1
  83.  
  84. '===initialize structure with size of the control======
  85.     If tb.cols = 0 Then tb.cols = tb.num + 1
  86.     If tb.num = 0 Then tb.num = UBound(page)
  87.     If tb.offset = 0 Then tb.offset = 4
  88.     If tb.insetx = 0 Then tb.insetx = 8 * tb.twp.x
  89.     If tb.insety = 0 Then tb.insety = 8 * tb.twp.y
  90.     '
  91.     tb.rows = tb.num \ tb.cols + 1
  92.  
  93. '---set height of invbox & tabbox based on textsize
  94.     tb.tab.Height = (tbox.TextHeight("X") + tb.offset)
  95.     tb.box.Height = tb.tab.Height * tb.rows
  96.     ' add 2 pixels to boxheight for 'focus' lines
  97.     theight% = (tb.box.Height + 2) * tb.twp.x
  98.  
  99. '---set an integral pixel width for invbox & tabbox
  100.     If aligned Then
  101.     pagewidth = page(0).Width \ tb.twp.x
  102.     tb.tab.Width = (pagewidth + (2 * tb.insetx \ tb.twp.x)) \ tb.cols
  103.     tb.box.Width = tb.tab.Width * tb.cols
  104.     tb.Width = tb.box.Width * tb.twp.x
  105.     Else
  106.     'for 'nonaligned', use tbox.width by default
  107.     If tb.Width = 0 Then
  108.         tb.tab.Width = (tbox.Width \ tb.cols) \ tb.twp.x
  109.         tb.Width = tbox.Width
  110.     Else
  111.     'adjust the value set by the user
  112.         tb.tab.Width = (tb.Width \ tb.cols) \ tb.twp.x
  113.     End If
  114.     tb.box.Width = tb.tab.Width * tb.cols
  115.     pagewidth = tb.box.Width - 2 * tb.insetx \ tb.twp.x
  116.     End If
  117.  
  118. '--- Calculate size of Page() height & inset---------------
  119.     If aligned Then
  120.     'use page(0) to set control and form height
  121.     pageheight = page(0).Height \ tb.twp.y
  122.     tb.insetx = (tb.Width - page(0).Width) \ 2
  123.     pheight% = page(0).Height + 2 * tb.insety
  124.     Else
  125.     If tb.Height = 0 Then
  126.         'if it wasn't specified, there's no way
  127.         'to set it
  128.         MsgBox "Must specify a control height: tb.Height = (some value)"
  129.     Else
  130.     pageheight = (tb.Height - theight%) \ tb.twp.y - 2 * tb.insety \ tb.twp.y
  131.     'pheight% = pageheight * tb.twp.y + 2 * tb.insety
  132.     pheight% = (tb.Height - theight)
  133.        End If
  134.     End If
  135.  
  136. '----height of entire control-----
  137.     If aligned Then
  138.     tb.Height = theight% + pheight%
  139.     End If
  140. 'all fields show now be initialized (except minwidth)
  141.  
  142. '===position it all according to the align paramater=======
  143. pageleft = tb.left + tb.insetx
  144. If tb.orient Then 'tabs down
  145.     pagetop = tb.top + tb.insety
  146.     tabtop = tb.top + pheight%
  147. Else ' tabs up
  148.     pagetop = tb.top + tb.insety + theight%
  149.     tabtop = tb.top
  150. End If
  151. '---size all the pages to fit Page(0)
  152. For i = 0 To tb.num
  153.     page(i).Move pageleft, pagetop, pagewidth * tb.twp.x, pageheight * tb.twp.y
  154. Next
  155. tbox.Move tb.left, tabtop, tb.Width, theight%
  156.  
  157. '----Draw the constant elements-----
  158. DrawTabs ibox, tbox, tb
  159. '----now resize the form
  160. w = tb.Width + tb.twp.bx
  161. h = tb.Height + tb.twp.by
  162. If tb.twp.x = 1 Then
  163.     w = w * screen.TwipsPerPixelX
  164.     h = h * screen.TwipsPerPixelY
  165. End If
  166. If aligned Then
  167.     F.Move F.left, F.top, tb.Width + tb.twp.bx, tb.Height + tb.twp.by
  168. End If
  169. page(tb.active).ZOrder
  170. End Sub
  171.  
  172. Sub DrawTabs (ibox As Control, tbox As Control, tb As TabData)
  173. Debug.Print "Entering DrawTabs------------"
  174. 'called by DefineControl
  175. 'called by TabResize for sizable windows
  176. Dim n%                  'line color (shadow/hilite)
  177. Dim box As RECT
  178. Dim yoff%, xoff%        'inset for angled line
  179. Dim top2%               'hilite/shadow line
  180. Dim invert%             '+/- multiplier
  181. Dim x%, y%, res%
  182. Dim n1%, n2%
  183.  
  184. ibox.Cls
  185. ibox.Move 0, 0, tb.tab.Width, tb.tab.Height
  186. 'set color and scale
  187. box.left = 0: box.right = ibox.ScaleWidth - 1
  188. xoff = 4
  189. If tb.orient Then 'tabs down
  190.     n = 8 'darkgrey
  191.     'tbox.Scale (0, tbox.ScaleHeight - 1)-(tbox.ScaleWidth, -1)
  192.     box.bottom = -1
  193.     box.top = ibox.ScaleHeight - 1
  194.     top2 = box.top - 1
  195.     yoff = box.top - 4
  196.     invert = -1
  197. Else
  198.     n = 15 'white
  199.     box.top = 0: box.bottom = ibox.ScaleHeight
  200.     top2 = 1
  201.     yoff = 4
  202.     invert = 1
  203. End If
  204.  
  205. ' Draw black lines
  206. ibox.Line (box.left, yoff)-(xoff, box.top)                 'angle
  207. ibox.Line -(box.right - xoff - 1, box.top)                'box.top
  208. ibox.Line (box.right - xoff - 1, box.top)-(box.right, yoff + 1 * invert)  'angle
  209. ibox.Line (box.right, box.top)-(box.right, box.bottom)                       'box.right
  210. ' Draw white/grey lines
  211. ibox.Line (box.left, box.bottom)-(box.left, yoff + 1 * invert), QBColor(15)   'box.left
  212. ibox.Line -(xoff, top2), QBColor(15)            'angle
  213. ibox.Line -(box.right - xoff - 1, top2), QBColor(n)   'top
  214. ibox.Line -(box.right - 1, yoff + 1 * invert), QBColor(8)      'angle
  215. ibox.Line -(box.right - 1, box.bottom), QBColor(8)               'right
  216. ibox.Line (box.left, box.top)-(box.left, yoff), QBColor(15)
  217. ibox.Line (box.right, box.top)-(box.right, yoff)
  218. ibox.Line (box.right - 1, box.top)-(box.right - 1, yoff), QBColor(8)
  219.  
  220. 'blit to all the lower rows
  221. tbox.Visible = 0
  222. tbox.AutoRedraw = -1
  223. If tb.rows > 1 Then
  224.     If tb.orient Then
  225.     n1 = 0: n2 = tb.rows - 2
  226.     Else
  227.     n1 = 1: n2 = tb.rows - 1
  228.     End If
  229.     For y = n1 To n2
  230.     For x = 0 To tb.cols - 1
  231.     If tb.orient Then
  232.     res = BitBlt(tbox.hDC, x * tb.tab.Width, y * tb.tab.Height + 2, tb.tab.Width, tb.tab.Height + 2, ibox.hDC, 0, 0, SRCCOPY)
  233.     Else
  234.     res = BitBlt(tbox.hDC, x * tb.tab.Width, y * tb.tab.Height, tb.tab.Width, tb.tab.Height, ibox.hDC, 0, 0, SRCCOPY)
  235.     End If
  236.     Next: Next
  237. End If
  238.  
  239. 'add some grey for the background
  240. ibox.Line (0, box.top)-(0, yoff), QBColor(8)
  241. ibox.Line (1, box.top)-(1, yoff - 1 * invert), QBColor(8)
  242. ibox.Line (2, box.top)-(2, yoff - 2 * invert), QBColor(8)
  243. ibox.Line (box.right, box.top)-(box.right, yoff + 1 * invert), QBColor(8)
  244. ibox